COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% This program by D. E. Knuth is not copyrighted and can be used freely.
C00004 00003	@* Introduction.
C00011 00004	@* The character set.
C00016 00005	@* Inputting the data.
C00021 00006	@* Outputting the darknesses.
C00028 00007	@* The ARIES scheme.
C00033 00008	@* Computing the class table.
C00039 00009	@* The main program.
C00040 00010	@* Index.
C00051 ENDMK
C⊗;
% This program by D. E. Knuth is not copyrighted and can be used freely.

% Here is TeX material that gets inserted after \input webmac
\def\title{DDTONE}
\font\logo=logo10
\def\MF{\logo METAFONT}
\magnify{\magstep1}
%\pagewidth=4.2truein % estimate to match CACM line length
\setpage
%\tolerance=1000

%\advance\topskip by \baselineskip	% doublespacing
%\advance\smallskipamount by \baselineskip
%\advance\baselineskip by \baselineskip

\def\con{\par\vfill\eject % finish the section names
  \rightskip 0pt \hyphenpenalty 50 \tolerance 200
  \setpage
  \output{\normaloutput\page\lheader\rheader}
  \titletrue % prepare to output the table of contents
  \pageno=\contentspagenumber \def\rhead{TABLE OF CONTENTS}
  \message{Table of contents:}
  \topofcontents
  \line{{\bf Sample}\hfil Section}
  \def\Z##1##2##3{\line{\ignorespaces##1
    \leaders\hbox to .5em{.\hfil}\hfil\hbox to2em{\hss##2}}}
  \readcontents\relax % read the contents info
  \botofcontents \end} % print the contents page(s) and terminate
@* Introduction.
This program writes a \TeX\ file that creates an illustration for
my paper on dot diffusion. Various change files will modify the
code to make it do different things.

(I obtained it from \.{SDTONE}.)

@ Here's an outline of the entire Pascal program:

@p program ddtone(@!output);
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var@?@<Global variables@>@/
@#
procedure initialize; {this procedure gets things started properly}
	var@?@<Local variables for initialization@>@/
	begin @<Set initial values@>@;
	end;@#
@<Basic procedures@>
begin initialize; @<The main program@>;
end.

@ The picture in the input data is assumed to contain |mm| rows and |nn| columns.

@d mm=360 {this many rows}
@d nn=250 {this many columns}

@ The main program has one statement label, namely |cleanup_and_terminate|.

@d cleanup_and_terminate=9998
@d finish==goto cleanup_and_terminate
 {do this when all the pictures have been output}

@<Labels in...@>=cleanup_and_terminate;

@ It's convenient to declare a macro for incrementation.

@d incr(#) == #←#+1
@* The character set.
We need translation tables between ASCII and the actual character
set, in order to make this program portable. The standard conventions of
{\sl \TeX: The Program\/} are copied here, essentially verbatim.

@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}

@<Types...@>=
@!ASCII_code=0..127; {seven-bit numbers}

@ @<Glob...@>=
@!xord: array [text_char] of ASCII_code;
	{specifies conversion of input characters}
@!xchr: array [ASCII_code] of text_char;
	{specifies conversion of output characters}

@ @<Set init...@>=
xchr[@'40]←' ';
xchr[@'41]←'!';
xchr[@'42]←'"';
xchr[@'43]←'#';
xchr[@'44]←'$';
xchr[@'45]←'%';
xchr[@'46]←'&';
xchr[@'47]←'''';@/
xchr[@'50]←'(';
xchr[@'51]←')';
xchr[@'52]←'*';
xchr[@'53]←'+';
xchr[@'54]←',';
xchr[@'55]←'-';
xchr[@'56]←'.';
xchr[@'57]←'/';@/
xchr[@'60]←'0';
xchr[@'61]←'1';
xchr[@'62]←'2';
xchr[@'63]←'3';
xchr[@'64]←'4';
xchr[@'65]←'5';
xchr[@'66]←'6';
xchr[@'67]←'7';@/
xchr[@'70]←'8';
xchr[@'71]←'9';
xchr[@'72]←':';
xchr[@'73]←';';
xchr[@'74]←'<';
xchr[@'75]←'=';
xchr[@'76]←'>';
xchr[@'77]←'?';@/
xchr[@'100]←'@@';
xchr[@'101]←'A';
xchr[@'102]←'B';
xchr[@'103]←'C';
xchr[@'104]←'D';
xchr[@'105]←'E';
xchr[@'106]←'F';
xchr[@'107]←'G';@/
xchr[@'110]←'H';
xchr[@'111]←'I';
xchr[@'112]←'J';
xchr[@'113]←'K';
xchr[@'114]←'L';
xchr[@'115]←'M';
xchr[@'116]←'N';
xchr[@'117]←'O';@/
xchr[@'120]←'P';
xchr[@'121]←'Q';
xchr[@'122]←'R';
xchr[@'123]←'S';
xchr[@'124]←'T';
xchr[@'125]←'U';
xchr[@'126]←'V';
xchr[@'127]←'W';@/
xchr[@'130]←'X';
xchr[@'131]←'Y';
xchr[@'132]←'Z';
xchr[@'133]←'[';
xchr[@'134]←'\';
xchr[@'135]←']';
xchr[@'136]←'↑';
xchr[@'137]←'_';@/
xchr[@'140]←'`';
xchr[@'141]←'a';
xchr[@'142]←'b';
xchr[@'143]←'c';
xchr[@'144]←'d';
xchr[@'145]←'e';
xchr[@'146]←'f';
xchr[@'147]←'g';@/
xchr[@'150]←'h';
xchr[@'151]←'i';
xchr[@'152]←'j';
xchr[@'153]←'k';
xchr[@'154]←'l';
xchr[@'155]←'m';
xchr[@'156]←'n';
xchr[@'157]←'o';@/
xchr[@'160]←'p';
xchr[@'161]←'q';
xchr[@'162]←'r';
xchr[@'163]←'s';
xchr[@'164]←'t';
xchr[@'165]←'u';
xchr[@'166]←'v';
xchr[@'167]←'w';@/
xchr[@'170]←'x';
xchr[@'171]←'y';
xchr[@'172]←'z';
xchr[@'173]←'{';
xchr[@'174]←'|';
xchr[@'175]←'}';
xchr[@'176]←'~';@/
xchr[0]←' '; xchr[@'177]←' ';
	{ASCII codes 0 and |@'177| do not appear in text}

@ @<Local variables for init...@>=
i:0..last_text_char;

@ @<Set init...@>=
for i←1 to @'37 do xchr[i]←' ';
for i←first_text_char to last_text_char do xord[chr(i)]←@'177;
for i←1 to @'176 do xord[xchr[i]]←i;
@* Inputting the data.
The input appears in a file of 8-bit bytes, with \.{00} representing black
and \.{FF} representing white. There are $mm\times nn$ bytes; they appear in
order from top to bottom and left to right just as we normally read a page
of text.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}

@ @<Glob...@>=
@!bytes_in:byte_file;

@ We assume that the input file is called `\.{mona.250[grf,dek]}'.

@<Constants in the outer block@>=
@!input_name='mona.250[grf,dek]';

@ @<Open the input file@>=
reset(bytes_in,input_name,'/B:8')

@ There isn't room to store all the little pixels in memory at once, but
it suffices to keep buffers for about a dozen rows near the current area
being computed.

@d white=0 {denotes a white pixel in the output}
@d black=1 {denotes a black pixel in the output}

@<Glob...@>=
@!ii:integer; {the buffer holds rows |8ii-7| through |8ii+15|}
@!buffer:array[-11..11,-3..nn+4] of real; {densities in twelve current rows}
@!darkness:array[-11..11,-3..nn+4] of white..black; {darknesses in buffer rows}
@!new_row:array[-3..nn+4] of real; {densities in row being input}

@ The |get_in| procedure computes the densities in a specified row
and puts them in |new_row|. This procedure is called successively for
|i=1|, 2,~\dots\thinspace.

@<Basic procedures@>=
procedure get_in(@!i:integer);
var @!j:integer;
@!t:eight_bits; {byte of input}
begin for j←-3 to 0 do new_row[j]←0.0;
if i>mm then for j←1 to nn do new_row[j]←0.0
else for j←1 to nn do
	begin read(bytes_in,t); new_row[j]←(255.5-t)/256.0;
	end;
for j←nn+1 to nn+4 do new_row[j]←0.0;
end;

@ Here is a procedure that ``rolls'' the buffer down eight lines:

@<Basic procedures@>=
procedure roll;
var @!j:-3..nn+4;
@!i:-11..11;
@!k:integer;
begin for i←-11 to 3 do for j←-3 to nn+4 do
	begin buffer[i,j]←buffer[i+8,j]; darkness[i,j]←darkness[i+8,j];
	end;
incr(ii);
for i←4 to 11 do
	begin get_in(8*ii+i+4);
	for j←-3 to nn+4 do
		begin buffer[i,j]←new_row[j]; darkness[i,j]←white;
		end;
	end;
end;

@ It's tedious but not difficult to get everything started.
We put zeros above the top lines in the picture.

@<Initialize the buffers@>=
for i←-11 to 4 do for j←-3 to nn+4 do
	begin buffer[i,j]←0.0; darkness[i,j]←white;
	end;
ii←-1;
for i←5 to 11 do
	begin get_in(i-4);
	for j←-3 to nn+4 do
		begin buffer[i,j]←new_row[j]; darkness[i,j]←white;
		end;
	end
@* Outputting the darknesses.
The output is assumed to make use of a font with 256 characters,
where each character prints a pattern for eight pixels of output.
Character 0 makes eight white pixels; character 1 makes seven white
and one black; character 2 makes six white, one black, one white;
and so on.

Rows of characters are specified as a line of two-digit hexadecimal
codes followed by `.'.

@<Glob...@>=
@!out_byte:eight_bits;
@!out_digit:0..15;
@!i,@!j,@!k:integer;
@!pt:array[0..7] of integer; {powers of two}

@ @<Set init...@>=
pt[7]←1;
for i←6 downto 0 do pt[i]←2*pt[i+1];

@ @<Set |out_byte| to the eight darknesses that begin at |[i,j]|@>=
begin out_byte←0;
for k←j to j+7 do if k≤nn then
	if darkness[i,k]=black then out_byte←out_byte+pt[k-j];
end

@ Here we output eight consecutive rows.

@<Output the pixel values for the top eight rows of the buffer@>=
for i←-11 to -4 do
	begin j←1;
	repeat @<Set |out_byte|...@>;
	out_digit←out_byte div 16;
	if out_digit<10 then write(xchr["0"+out_digit])
	else write(xchr["A"-10+out_digit]);
	out_digit←out_byte mod 16;
	if out_digit<10 then write(xchr["0"+out_digit])
	else write(xchr["A"-10+out_digit]);
	j←j+8;
	until j>nn;
	write_ln('.');
	end
@* The ARIES scheme.
Pixels are divided into 32 classes, numbered from 0 to~31, and grouped
into diamonds with one element from each class in each diamond.
We subtract $k/16$ from the pixels of class $k$, then choose the largest
$d$ values in each diamond, where $d$ is the desired density.

This program does all its work in buffer rows |0..10|. The buffer
is actually bigger than this, because we're using a more general
buffering method and hacking it down.

@<Choose pixel values and diffuse the errors in the buffer@>=
iii←3;
repeat jj←1-iii;
 repeat sum←0.0;
 for i←-3 to 3 do for j←-3+abs(i) to 4-abs(i) do
	begin k←class_number[i+7,j+2] div 2;
	if jj+j<1 then s[k]←buffer[iii+i,1]
	else if jj+j>nn then s[k]←buffer[iii+i,nn]
	else s[k]←buffer[iii+i,jj+j];
	sum←sum+s[k];
	s[k]←s[k]-k/16; si[k]←iii+i; sj[k]←jj+j;
	end;
 d←trunc(sum+0.5); @<Sort the $s$ array@>;
 for k←0 to d-1 do if sj[k]>0 then if sj[k]≤nn then darkness[si[k],sj[k]]←black;
 jj←jj+8;
 until jj>nn+3;
iii←iii+4;
until iii=11

@ I wouldn't have to sort the whole array; only the top $d$ values are needed.
But it's got only 32 elements in it, and this isn't a production program.

@<Sort...@>=
for k←1 to 31 do if s[k-1]<s[k] then
	begin j←k; ss←s[k]; ssi←si[k]; ssj←sj[k];
	repeat s[j]←s[j-1]; si[j]←si[j-1]; sj[j]←sj[j-1]; j←j-1;
	until s[j-1]≥ss;
	s[j]←ss; si[j]←ssi; sj[j]←ssj;
	end

@ @<Glob...@>=
@!class_number:array[-14..11,-3..12] of 0..63; {number of a given position}
@!s:array[-1..31] of real; {values to sort}
@!si,@!sj:array[0..31] of integer; {buffer location of |s| values}
@!ss:real; @!ssi,@!ssj:integer; 
@!sum:real; {total density in current diamond}
@!d:integer; {rounded density in the current diamond}
@!iii,@!jj:integer; {diamond coordinates}
@!err_black:real; {defined only because a change file uses it}

@ @<Set init...@>=
s[-1]←100.0; {infinity}
@* Computing the class table.
The |class_number| table could be specified by a large number
of boring assignment statements, but it is more fun to compute it by a method
that shows some of the mysterious underlying structure.

@ The order of classes
used here is the order in which pixels might be blackened in a font
for halftones based on dots in a 45$↑\circ$ grid.

@<Basic procedures@>=
procedure store(@!i,@!j:integer); {establish new |class_row|, |class_col|}
begin if i<1 then i←i+8@+else if i>8 then i←i-8;
if j<1 then j←j+8@+else if j>8 then j←j-8;
class_number[i,j]←k; incr(k);
end;
@#
procedure store_eight(@!i,@!j:integer); {rotate and shift for eight classes}
begin store(i,j); store(i-4,j+4); store(5-j,i); store(1-j,i-4);@/
store(4+j,1-i); store(j,5-i); store(5-i,5-j); store(1-i,1-j);
end;

@ @<Initialize the class number matrix@>=
k←0; store_eight(7,2); store_eight(8,3); store_eight(8,2); store_eight(8,1);@/
store_eight(1,4); store_eight(1,3); store_eight(1,2); store_eight(2,3);@/
for i←1 to 8 do
	begin for j←-3 to 0 do class_number[i,j]←class_number[i,j+8];
	for j←9 to 12 do class_number[i,j]←class_number[i,j-8];
	end;
for i←0 downto -14 do for j←-3 to 12 do class_number[i,j]←class_number[i+8,j];
for i←9 to 11 do for j←-3 to 12 do class_number[i,j]←class_number[i-8,j];

@* The main program.
Now we're ready to put all the pieces together.

@<The main program@>=
@<Initialize the class...@>;
write_ln('\input ddtone'); write_ln; write_ln('\beginddtone');
@<Open...@>;
@<Initialize the buffers@>;
repeat @<Choose pixel values and diffuse the errors in the buffer@>;
if ii mod 5=0 then write(tty,'.');
if ii>0 then @<Output the pix...@>;
roll;
until 8*ii>mm;
write_ln('\endddtone');
cleanup_and_terminate:
@* Index.
Here are the quantities declared and/or used in the program.
(The uses of single-letter variables aren't indexed.)